.TITLE	DRCLI
	.IDENT	/01.03/
 
;
; THIS  SOFTWARE  IS FURNISHED UNDER A LICENSE AND MAY
; BE USED OR COPIED ONLY IN ACCORDANCE WITH THE  TERMS
; OF SUCH LICENSE.
; 
; Copyright (c) 1995-1999 by Mentec, Inc., U.S.A.
; All rights reserved
;
;
; VERSION 01.01
;
; M. S. FOX	20-APR-81
;
;
; MODIFIED BY:
;
;	M. S. FOX	23-SEP-81
;
;		MF225 -- FIX CP.RST CHECKS, AND DO NOT ALLOW CLI
;			 TO BE SET IF TTY IS LOGGED OFF, AND CP.LGO=0
;
;	K. L. NOEL	13-MAY-88	
;
;		KLN101 -- SEND PROMPT INFORMATION OVER TO PARENT AME FOR CPR
;
;	K. L. NOEL	07-OCT-88	
;
;		KLN109 -- ALLOW CLI TO DO IT'S OWN PROMPTING
;
;+
; **-$DRCLI-SET CLI / GET CLI INFO / DECLARE CMD ARRIVAL AST DIRECTIVES
;
; THIS MODULE CONTAINS THE GET CLI INFORMATION AND SET CLI
; DIRECTIVES. IT ALSO GETS CALLED BY DRDSP FOR THE DECLARE
; COMMAND ARRIVAL AST DIRECTIVE, BUT IMMEDIATEDLY JUMPS TO
; THE $CAAST ENTRY POINT OF THE DRPUT MODULE FOR PROCESSING.
;
; INPUTS:
;
;	R2=ADDRESS OF THE SECOND TASK STATUS WORD OF THE CURRENT TASK
;	R3=ADDRESS OF THE SECOND WORD IN THE DPB
;	R4=ADDRESS OF THE HEADER OF THE CURRENT TASK
;	R5=ADDRESS OF THE TCB OF THE CURRENT TASK
;
;-

	.IF DF	A$$CLI


	.IF DF	M$$CLI

	.ERROR			;CANNOT DEFINE BOTH M$$CLI AND A$$CLI

	.ENDC	;M$$CLI

	.MCALL	PKTDF$,UCBDF$
	PKTDF$			;DEFINE CPB OFFSETS
	UCBDF$			;DEFINE UCB OFFSETS

	ASSUME	UM.CLI,36	;BITS TO INDICATE TERMINALS CLI
	ASSUME	C.PTCB,0	;TCB ADDRESS MUST BE AT OFFSET ZERO OF CPB

$DRCLI::MOVB	-(R3),R0	;GET DPB SIZE
	CMPB	#5,(R3)+	;IS IT SET CLI (SCLI$)
	BEQ	SCLI		;IF EQ YES, PROCESS SCLI$ DIRECTIVE
	CMPB	#2,R0		;IS IT DECLARE CMD ARRIVAL AST (SCAA$)
	BNE	10$		;IF NE NO
	JMP	$CAAST		;PROCESS DIRECTIVE IN DRPUT
10$:	CMPB	#7,R0		;IS IT GET CLI INFORMATION (GCII$)
	BEQ	GCII		;IF EQ YES, PROCESS GCII$
	DRSTS	D.RS99		;ILLEGAL DPB SIZE

;+
; **-SCLI- SET A TERMINAL'S CLI
;
; THIS DIRECTIVE INSTRUCTS THE SYSTEM TO SET THE CLI OF THE
; CURRENT TASK'S TI: TERMINAL (OR SPECIFIED TERMINAL) TO BE THE
; SPECIFIED CLI. SYSTEM MESSAGES INFORMING BOTH THE PREVIOUS AND
; NEW CLIS OF THE CHANGE ARE SENT TO THE CLIS IF THEY DESIRE THEM.
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(173.),DPB SIZE(5.)
;	WD. 01 -- ASCII NAME OF THE TERMINAL WHOSE CLI SHOULD BE SET
;	WD. 02 -- OCTAL UNIT NUMBER OF TERMINAL
;	WD. 03 -- FIRST HALF OF RAD50 NAME OF THE DESIRED CLI
;	WD. 04 -- SECOND HALF OF THE RAD50 NAME OF THE DESIRED CLI
;
; OUTPUTS: (DIRECTIVE STATUS AND PS RETURNED TO TASK)
;
;	C=0 IF DIRECTIVE IS SUCCESSFULLY COMPLETED.
;		DIRECTIVE STATUS OF +1 IS RETURNED.
;	C=1 IF DIRECTIVE IS REJECTED.
;		DIRECTIVE STATUS OF 'D.RS99' IS RETURNED IF THE
;			LENGTH IS ILLEGAL
;		DIRECTIVE STATUS OF 'D.RS16' IS RETURNED IS THE
;			ISSUING TASK IS NOT PRIVILEGED.
;		DIRECTIVE STATUS OF 'D.RS92' IS RETURNED IF AN
;			NON-EXISTANT OR NON-TERMINAL DEVICE IS SPECIFIED.
;		DIRECTIVE STATUS OF 'D.RS2' IS RETURNED IF THE SPECIFIED
;			CLI DOES NOT EXIST.
;		DIRECTIVE STATUS OF 'D.RS1' IS RETURNED IF THERE IS
;			INSUFFICIENT POOL SPACE.
;		DIRECTIVE STATUS OF 'D.RS8' IS RETURNED IF THE
;			TERMINAL IS LOGGED OFF, AND CP.LGO IS CLEAR
;
;-

SCLI:	BIT	#T3.PRV!T3.CLI,T.ST3(R5) ;CAN TASK USE THIS DIRECTIVE?
	BEQ	40$		;IF EQ NO
	MOV	(R3)+,R0	;GET DEVICE NAME
	BNE	10$		;IF NE, GOT ONE
	MOV	T.UCB(R5),R0	;GET CURRENT TASK'S TI:
	TST	(R3)+		;SKIP UNIT NUMBER FIELD
	BR	20$		;
10$:	MOV	(R3)+,R1	;GET UNIT NUMBER
	MOV	R3,-(SP)	;SAVE POINTER TO CLI NAME
	CALL	$CVDVN		;CONVERT TO UCB ADDRESS
	BCS	50$		;IF CS, DEVICE DOES NOT EXIST
	MOV	R2,R0		;COPY UCB ADDRESS
	CALL	$MPLND		;FOLLOW REDIRECT CHAIN
	BIT	#DV.TTY,U.CW1(R0) ;IS DEVICE A TERMINAL
	BEQ	50$		;IF EQ NO
	MOV	(SP)+,R3	;POINT TO CLI NAME IN CPB
20$:
	.IF DF C$$RMT		; REMOTE TASK SUPPORT

	BIT	#F5.RTK,$FMSK5	; REMOTE TASK SUPPORT TURNED ON?
	BEQ	25$		; IF EQ NO

	CLR	$CPPKT		;MAKE SURE NO PACKET ADDRESS IS LEFT IN THERE
	CMP	T.UCB(R5),R0	;IS REQUEST FOR OWN CLI?
	BNE	25$		;IF NE NO

	MOV	R0,R4		;SAVE UCB ADDRESS
	MOV	R3,R5		;SAVE POINTER TO CLI NAME
	MOV	#1,R1		;ALLOCATE A PACKET OF SIZE 1
	MOV	#AL$BCK!AL$IMP,R0 ;BLOCK TASK AND DO IMPLICIT TASK START

	CALL	$CPALO		;ALLOCATE PACKET

	MOV	R0,$CPPKT	;STORE PACKET ADDRESS FOR $STCLI
	MOV	R4,R0		;RESTORE UCB ADDRESS
	MOV	R5,R3		;RESTORE POINTER TO CLI NAME
	MOV	$TKTCB,R5	;GET TCB ADDRESS BACK
25$:
	.ENDC	;C$$RMT

	CALL	$STCLI		;SET THE TERMINAL'S CLI
	BCC	60$		;IF CC, SUCCESS
	TST	R0		;IDENTIFY ERROR
	BEQ	40$		;IF EQ, PRIV VIOLATION
	BPL	30$		;IF PL, NO POOL
	DRSTS	D.RS2		;CLI NOT IN SYSTEM
30$:	DEC	R0		;ALLOCATION FAILURE?
	BNE	35$		;IF NE YES
	DRSTS	D.RS8		;TERMINAL NOT LOGGED IN, CP.LGO CLEAR
35$:	DRSTS	D.RS1		;ALLOCATION FAILURE
40$:	DRSTS	D.RS16		;PRIVILEGE VIOLATION
50$:	DRSTS	D.RS92		;ILLEGAL DEVICE SPECIFIED
60$:	RETURN			;SUCCESS

;+
; **-GCII-GET CLI INFORMATION DIRECTIVE
;
; THIS DIRECTIVE INSTRUCTS THE SYSTEM TO FILL A BUFFER IN THE CURRENT
; TASK SPACE WITH INFORMATION ABOUT HIS OWN OR A SPECIFIED CLI. THE
; ISSUING TASK MUST BE PRIVILEGED TO GET INFORMATION ABOUT A CLI
; WHICH IS NOT THE CLI OF ITS TI: TERMINAL. IF THE BUFFER IS NOT
; LONG ENOUGH TO CONTAIN ALL THE DATA, IT IS FILLED FROM LEFT
; TO RIGHT WITH AS MUCH DATA AS WILL FIT. NO INDICATION WILL
; BE GIVEN TO THE TASK THAT ITS BUFFER IS TOO SHORT. THIS ALLOWS
; NEW DATA ITEMS TO BE RETURNED BY FUTURE VERSIONS OF THIS DIRECTIVE,
; SINCE OLD TASKS WILL CONTINUE TO WORK. THEY JUST WILL NOT SEE
; THE NEW DATA.
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(173.),DPB SIZE(7).
;	WD. 01 -- ADDRESS OF BUFFER IN CURRENT TASK'S SPACE
;	WD. 02 -- LENGTH OF THE TASK'S BUFFER
;	WD. 03 -- FIRST HALF OF NAME OF CLI TO RETURN DATA ON
;	WD. 04 -- SECOND HALF OF NAME OF CLI TO RETURN DATA ON
;	WD. 05 -- ASCII NAME OF TERMINAL WHOSE CLI SHOULD BE USED
;	WD. 06 -- OCTAL UNIT NUMBER OF TERMINAL
;
; OUTPUTS: (DIRECTIVE STATUS AND PS RETURNED TO TASK)
;
;	C=0 IF DIRECTIVE IS SUCCESSFULLY COMPLETED.
;		DIRECTIVE STATUS OF +1 IS RETURNED.
;	C=1 IF DIRECTIVE IS REJECTED.
;		DIRECTIVE STATUS OF 'D.RS99' IS RETURNED IF THE
;			DPB LENGTH IS INVALID.
;		DIRECTIVE STATUS OF 'D.RS98' IS RETURNED IF THE BUFFER
;			IS NOT ENTIRELY WITHIN THE USER'S TASK SPACE.
;		DIRECTIVE STATUS OF 'D.RS81' IS RETURNED IF BOTH THE
;			NAMES OF THE CLI AND TERMINAL ARE SUPPLIED.
;		DIRECTIVE STATUS OF 'D.RS2' IS RETURNED IF THE
;			SPECIFIED CLI DOES NOT EXIST.
;		DIRECTIVE STATUS OF 'D.RS92' IS RETURNED IF THE
;			SPECIFIED DEVICE IS NOT A TERMINAL.
;		DIRECTIVE STATUS OF 'D.RS16' IS RETURNED IF A NON-PRIV
;			TASK ATTEMPTS TO GET INFO ON A CLI WHICH IS
;			NOT ASSOCIATED WITH ITS TI:
;
;-

;
; THE FORMAT OF THE INFORMATION BUFFER IN THE TASK'S ADDRESS SPACE IS:
;
;	+---------------------------------------+
;	!	NAME OF CLI			!
;	!	(2 WORDS)			!
;	!---------------------------------------!
;	!	CLI STATUS WORD FROM CPB	!
;	!---------------------------------------!
;	!	NAME OF TASK SERVING AS CLI	!
;	!	(2 WORDS)			!
;	!---------------------------------------!
;	!	TERMINAL'S U.CW2		!
;	!---------------------------------------!
;	!	TERMINAL'S PROTECTION UIC	!
;	!---------------------------------------!
;	!	TERMINAL'S CURRENT UIC		!
;	!---------------------------------------!
;	!					!
;	!	DEFAULT PROMPT STRING		!
;	!	(1 BYTE LENGTH, FOLLOWED BY	!
;	!		31. BYTES STRING)	!
;	+---------------------------------------+
;
;

GCII:	MOV	(R3)+,R0	;GET ADDRESS OF BUFFER
	MOV	(R3)+,R1	;GET LENGTH OF BUFFER
	MOV	R1,-(SP)	;SAVE LENGTH
	MOV	R0,-(SP)	;SAVE ADDRESS
	CALL	$ACHKW		;ADDRESS CHECK BUFFER
	MOV	R5,R2		;COPY CURRENT TCB ADDRESS
	MOV	T.UCB(R5),R5	;POINT TO CURRENT TASK'S TI:
	TST	(R3)		;WAS A CLI NAME SPECIFIED
	BEQ	10$		;IF EQ NO
	TST	4(R3)		;WAS A TERMINAL SPECIFIED
	BNE	100$		;IF NE YES
	CALL	$FNCLI		;FIND THE SPECIFIED CLI
	BCS	110$		;IF CS, CLI DOES NOT EXIST
	MOV	U.MUP(R5),R3	;GET WORD CONTAINING TI:S CLI INDICATOR
	BIC	#^CUM.CLI,R3	;ISOLATE CLI INDICATOR BITS
	CMP	R3,R1		;LOOKING AT TI:S CLI??
	BEQ	200$		;IF EQ YES
	BR	30$		;REQUIRE PRIVILEGE
10$:	CMP	(R3)+,(R3)+	;SKIP OVER CLI NAME IN DPB
	MOV	(R3)+,R0	;GET DEVICE NAME
	BEQ	20$		;IF EQ NO
	MOV	(R3)+,R1	;GET UNIT NUMBER
	CALL	$CVDVN		;CONVERT NAME TO UCB ADDRESS
	BCS	120$		;IF CS, DEVICE DOES NOT EXIST
	MOV	R2,R0		;COPY UCB ADDRESS
	CALL	$MPLND		;FOLLOW REDIRECT CHAIN
	MOV	R0,R5		;PUT UCB ADDRESS BACK IN R5
	BIT	#DV.TTY,U.CW1(R5) ;IS DEVICE A TERMINAL
	BEQ	120$		;IF EQ NO
20$:	MOV	U.MUP(R5),R4	;GET CLI INDICATOR FROM UCB
	BIC	#^CUM.CLI,R4	;ISOLATE IT
	MOV	$CPTBL(R4),R4	;POINT TO THE CPB
	MOV	$TKTCB,R2	;GET TCB ADDR OF CURRENT TASK
	CMP	T.UCB(R2),R5	;LOOKING AT CURRENT TASK'S TI:
	BEQ	200$		;IF EQ YES, DO NOT NEED PRIVILEGE
30$:	BIT	#T3.PRV!T3.CLI,T.ST3(R2) ;IS CURRENT TASK PRIVILEGED OR CLI
	BNE	200$		;IF NE YES
;
	DRSTS	D.RS16		;PRIVILEGE VIOLATION
100$:	DRSTS	D.RS81		;CANNOT SPECIFY BOTH TERMINAL AND CLI
110$:	DRSTS	D.RS2		;CLI DOES NOT EXIST
120$:	DRSTS	D.RS92		;ILLEGAL DEVICE SPECIFIED
;
200$:	MOV	(SP)+,R0	;GET ADDRESS OF USER BUFFER
	CALL	$RELOC		;RELOCATE USERS INFO BUFFER
	MOV	R1,KISAR6	;MAP BUFFER IN TASK SPACE
	MOV	(SP)+,R3	;GET LENGTH OF BUFFER
	ASR	R3		;CONVERT TO WORD COUNT
	SUB	#2,R3		;SPACE LEFT IN BUFFER FOR CLI NAME
	BLT	230$		;IF LT NO
	MOV	C.PNAM(R4),(R2)+ ;PUT NAME IN BUFFER
	MOV	C.PNAM+2(R4),(R2)+ ;SECOND HALF
	DEC	R3		;SPACE IN BUFFER FOR CPB STATUS WORD
	BLT	230$		;IF LT NO
	MOV	C.PSTS(R4),(R2)	;COPY STATUS WORD INTO BUFFER
	SUB	#2,R3		;SPACE LEFT IN BUFFER FOR TASK NAME
	BLT	230$		;IF LT NO
	MOV	(R4),R0		;POINT TO CLI'S TCB
	BIT	#CP.POL,(R2)+	;IS TCB IN SECONDARY POOL
	BEQ	210$		;IF EQ NO
	MOV	R0,KISAR6	;MAP TCB
	MOV	#140000,R0	;POINT TO IT
210$:	MOV	T.NAM+2(R0),-(SP) ;GET SECOND HALF OF TASK NAME
	MOV	T.NAM(R0),-(SP)	;FIRST HALF
	MOV	R1,KISAR6	;RESTORE MAPPING OF USER BUFFER
	MOV	(SP)+,(R2)+	;PUT TASK NAME IN USER BUFFER
	MOV	(SP)+,(R2)+	;
	DEC	R3		;SPACE LEFT IN BUFFER FOR TERMINAL'S U.CW2
	BLT	230$		;IF LT NO
	MOV	U.CW2(R5),(R2)+	;COPY U.CW2 INTO BUFFER
	DEC	R3		;SPACE FOR PROTECTION UIC??
	BLT	230$		;IF LT NO
	MOV	U.LUIC(R5),(R2)+ ;COPY PROTECTION UIC
	DEC	R3		;SPACE FOR CURRENT UIC
	BLT	230$		;IF LT NO
	MOV	U.UIC(R5),(R2)+	;COPY CURRENT UIC
	SUB	#16.,R3		;ENOUGH ROOM LEFT FOR PROMPT STRING
	BLT	230$		;IF LT NO
	CLR	R5		;
	BISB	C.PDPL(R4),R5	;GET LENGTH OF DEFAULT PROMPT
	DEC	R5		;DO NOT RETURN ZERO AT END OF PROMPT
	MOVB	R5,(R2)+	;PUT LENGTH IN BUFFER
	BEQ	230$		;IF EQ, NO PROMPT STRING
	ADD	#C.PRMT,R4	;POINT TO START OF STRING
220$:	MOVB	(R4)+,(R2)+	;COPY CHARACTER
	SOB	R5,220$
230$:	RETURN			;SUCCESS


;+
; **-$STCLI-ROUTINE TO SET A TERMINAL'S CLI
; **-$STCL1-ROUTINE TO SET A TERMINAL'S CLI (ALTERNATE ENTRY)
;
; THIS ROUTINE SETS THE CLI OF THE SPECIFIED TERMINAL FOR BOTH THE
; SCLI$ DIRECTIVE AND MCR. IF EITHER THE PREVIOUS OR NEW CLI HAVE
; THE CP.MSG BIT SET IN THEIR CPB'S, A MESSAGE PACKET IS CREATED AND
; PASSED TO THEM TO INFORM THEM OF THE CHANGE. NOTE THAT IF AN ALLOCATION
; FAILURE OCCURS WHEN ACTIVATING THE NEW CLI AFTER QUEUEING A MESSAGE
; TO IT, THE ERROR IS IGNORED SINCE IT WOULD BE IMPOSSIBLE TO UNWIND
; ACTIONS WHICH MAY HAVE ALREADY BEEN COMPLETED, SUCH AS DEACTIVATING
; THE PREVIOUS CLI AFTER A CALL TO $EXRQN. THE ONLY DRAWBACK TO THIS IS
; THAT THE NEW CLI WILL NOT GET THE MESSAGE IMMEDIATELY. THE BUFFER
; WILL BE LINKED IN ITS QUEUE, BUT THE CLI WILL NOT RECEIVE IT UNTIL IT
; GETS ACTIVATED AT A FUTURE POINT BY A COMMAND ARRIVAL OR ANOTHER
; SYSTEM MESSAGE.
;
; INPUTS:
;
;	R0=UCB ADDRESS OF TERMINAL TO SET
;	R3=POINTER TO THE NAME OF THE NEW CLI ($STCLI ONLY)
;	R1=OFFSET TO POINTER TO CPB IN $CPTBL ($STCL1 ONLY)
;	R4=CPB ADDRESS OF NEW CLI ($STCL1 ONLY)
;
; OUTPUTS:
;
;	C=1 CLI COULD NOT BE SET
;		R0=2 IF AN ALLOCATION FAILURE OCCURED
;		R0=1 IF THE TERMINAL IS LOGGED OFF, AND CP.LGO IS CLEAR
;		R0=0  IF THE CP.RST BIT IS SET, AND A TASK OTHER THAN
;			THE CLI IS ATTEMPTING TO SET A TERMINAL TO IT
;		R0=-1 IF THE CLI DOES NOT EXIST
;	C=0 THE CLI WAS SUCCESSFULLY SET UP FOR THE SPECIFIED TERMINAL
;
; ALL REGISTERS ARE MODIFIED
;
;-

;
MSGLEN=<C.CTXT+4+2+77>/100	;LENGTH OF MESSAGE PACKETS
;

	.IF NDF	D$$PAR

$STCLI::CALL	$FNCLI		;FIND THE SPECIFIED CLI

	.ENDC	;D$$PAR


$STCL1::MOV	KISAR6,-(SP)	;SAVE CURRENT MAPPING
	MOV	#-1,-(SP)	;SET EXIT STATUS WORD FOR THIS ROUTINE
	BCS	40$		;IF CS, CLI DOES NOT EXIST
	INC	(SP)		;SET EXIT STATUS TO RETURN R0=0
	MOV	U.MUP(R0),R3	;GET WORD CONTAINING CURRENT CLI
	BIC	#^CUM.CLI,R3	;ISOLATE CLI BITS
	MOV	$CPTBL(R3),R3	;GET CPB ADDRESS
	MOV	C.PSTS(R3),$TEMP0 ;SAVE CURRENT CLI'S STATUS WORD
	BIT	#CP.RST,$TEMP0	;DOES CURRENT CLI HAVE RESTRICTED ACCESS
	BEQ	3$		;IF EQ NO
	CMP	$TKTCB,(R3)	;IS OLD CLI ISSUING THIS DIRECTIVE
	BNE	80$		;IF NE NO
3$:	BIT	#CP.RST,C.PSTS(R4) ;IS ACCESS TO NEW CLI RESTRICTED
	BEQ	5$		;IF EQ NO
	CMP	$TKTCB,(R4)	;IS NEW CLI ISSUING THIS DIRECTIVE
	BNE	80$		;IF NE NO
5$:	INC	(SP)		;SET EXIT STATUS TO RETURN R0=1
	BIT	#U2.LOG,U.CW2(R0) ;IS TERMINAL LOGGED ON
	BEQ	7$		;IF EQ YES
	BIT	#CP.LGO,C.PSTS(R4) ;DOES CLI ACCEPT CMDS FROM LOGGED OFF TTYS
	BEQ	80$		;IF EQ NO
7$:	INC	(SP)		;SET EXIT STATUS TO RETURN R0=2
	MOV	R1,-(SP)	;SAVE OFFSET TO NEW CLI IN $CPTBL
	MOV	R0,-(SP)	;SAVE UCB ADDRESS
	CLR	R5		;ASSUME NO MESSAGE FOR NEW CLI
	BIT	#CP.MSG,C.PSTS(R4) ;DOES NEW CLI WANT A MESSAGE
	BEQ	10$		;IF EQ NO
	MOV	#MSGLEN,R1	;GET LENGTH OF MESSAGE
	CALL	$ALSEC		;ALLOCATE A MESSAGE
	BCS	70$		;IF CS, NO POOL
	MOV	R0,R5		;SAVE BUFFER ADDRESS
	MOV	R4,$TEMP1	;SAVE CPB ADDRESS
10$:	BIT	#CP.MSG,$TEMP0	;DOES CURRENT CLI WANT A MESSAGE
	BEQ	25$		;IF EQ NO
	MOV	#MSGLEN,R1	;GET MESSAGE LENGTH
	CALL	$ALSEC		;ALLOCATE A MESSAGE BUFFER
	BCS	60$		;IF CS, NO POOL
	MOV	R0,R1		;COPY BUFFER ADDRESS
	MOV	(SP),R2		;GET UCB ADDRESS
	MOV	R3,R4		;GET ADDRESS OF CURRENT CPB
	CALL	STMSG		;SET UP MESSAGE BUFFER
	MOV	#CM.RMT,@#C.CMCD+140000 ;INSERT MESSAGE CODE
	MOV	R1,-(SP)	;SAVE BUFFER ADDRESS
	CALL	$QCPKT		;QUEUE BUFFER AND REQUEST CLI
	BCC	20$		;IF CC, OK
	BNE	50$		;IF NE, ALLOCATION FAILURE
;
; AFTER THIS POINT, COMLETE ERROR RECOVERY IS IMPOSSIBLE, BECAUSE THE
; TASK MAY JUST HAVE BEEN ACTIVATED INSTEAD OF BEING MERELY UNSTOPPED.
;
20$:	TST	(SP)+		;DON'T NEED BUFFER ADDRESS ANYMORE
25$:	MOV	R5,R1		;POINT TO MESSAGE FOR NEW CLI
	BEQ	30$		;IF EQ, NO MESSAGE FOR NEW CLI
	MOV	$TEMP1,R4	;POINT TO NEW CPB
	MOV	(SP),R2		;GET UCB ADDRESS
	CALL	STMSG		;SET UP MESSAGE
	CALL	$QCPKT		;QUEUE MESSAGE AND REQUEST IT
				;DO NOT CHECK ERROR RETURNS
30$:	MOV	(SP)+,R0	;GET UCB ADDRESS OF TERMINAL
	MOV	(SP)+,R1	;GET OFFSET TO NEW CLI IN $CPTBL
	MTPS	#PR7		;;;PREVENT TTDRV FROM ANSWERING PHONE
				;;;WHEN CLI SETTING IS INVALID
	BIC	#UM.CLI!UM.DSB,U.MUP(R0) ;;;CLEAR OUT PREVIOUS CLI INDICATION
	BIS	R1,U.MUP(R0)	;;;SET NEW CLI
	MTPS	#0		;ALLOW INTERRUPTS
	CLC			;SUCCESS
40$:	MOV	(SP)+,R0	;SET EXIT STATUS
	MOV	(SP)+,KISAR6	;RESTORE ORIGINAL MAPPING

	.IF DF C$$RMT		;REMOTE TASK SUPPORT

	BIT	#F5.RTK,$FMSK5	;REMOTE TASK SUPPORT TURNED ON?
	BEQ	45$		;IF EQ NO

	TST	$CPPKT		;WAS PACKET ALLOCATED?
	BEQ	45$		;IF EQ NO

	CALL	SNDCLI		;SEND PACKET WITH PROMPTS 
45$:
	.ENDC	; C$$RMT

	RETURN			;ALL DONE
;
; ERROR CLEANUP CODE
;

; ERROR WHILE ACTIVATING CURRENT CLI, SO UNLINK AND DEALLOCATE MESSAGE
;
50$:	MOV	#$CLICQ,R0	;POINT TO CLI COMMAND QUEUE
	MOV	(SP)+,R1	;POINT TO BUFFER JUST QUEUED
	CALL	$GTSPK		;REMOVE MESSAGE JUST INSERTED IN QUEUE
	MOV	R1,R0		;COPY POINTER TO MESSAGE
	MOV	#MSGLEN,R1	;GET ITS LENGTH
	CALL	$DESEC		;DEALLOCATE IT
;
; DEALLOCATE MESSAGE FOR NEW CLI IF IT EXISTS
;
60$:	MOV	R5,R0		;POINT TO BUFFER FOR NEW CLI
	BEQ	70$		;IF EQ, IT DIDN'T WANT ONE
	MOV	#MSGLEN,R1	;SET LENGTH
	CALL	$DESEC		;DEALLOCATE BUFFER FOR NEW CLI
70$:	CMP	(SP)+,(SP)+	;CLEAN STACK
80$:
	.IF DF C$$RMT		;REMOTE TASK SUPPORT

	BIT	#F5.RTK,$FMSK5	;REMOTE TASK SUPPORT TURNED ON?
	BEQ	90$		;IF EQ NO

	MOV	$CPPKT,R0	;GET ADDRESS OF CPRBUF PACKET
	BEQ	90$		;IF EQ NONE

	CALL	$CPDEA		;DON'T NEED IT
	CLR	$CPPKT		;
90$:
	.ENDC	; C$$RMT

	SEC			;SET ERROR STATUS
	BR	40$		;GO TO COMMON EXIT CODE

;
; LOCAL ROUTINE TO SET UP MESSAGE BUFFERS
;
; INPUTS:
;	R1=ADDRESS OF MESSAGE BUFFER
;	R2=ADDRESS OF TERMINAL UCB
;	R4=ADDRESS OF CPB OF CLI TO RECEIVE MESSAGE
;
; OUTPUTS:
;
;	THE MESSAGE BUFFER IN SEC POOL IS FILLED IN AND LEFT MAPPED
;
; REGISTERS R1, R4, R5 PRESERVED
;

STMSG:	MOV	R1,-(SP)	;SAVE BUFFER ADDRESS
	MOV	R1,KISAR6	;MAP BUFFER
	MOV	#140002,R3	;POINT INTO BUFFER
	MOV	$MCRPT,(R3)+	;ALL MESSAGES GO THRU DISPATCHER ON M-PLUS
	MOV	R2,(R3)+	;INSERT UCB ADDRESS
	MOV	#4,(R3)+	;CHARACTER COUNT
	MOV	#CC.CLI!CC.MSG,(R3)+ ;INSERT STATUS BITS
	MOV	#CM.LKT,(R3)+	;ASSUME MESSAGE IS GOING TO NEW CLI
	MOV	#<MSGLEN*400>+33,(R3)+ ;INSERT LENGTH AND TERMINATOR
	MOV	R2,R1		;COPY UCB ADDR
	MOV	(R1),R2		;POINT TO DCB
	TST	(R2)+		;POINT TO ADDRESS OF FIRST UCB
	SUB	(R2)+,R1	;CALC RELATIVE ADDRESS OF UCB
	MOV	(R2)+,(R3)+	;COPY DEVICE NAME
	MOV	(R2)+,(R3)	;GET LOW UNIT NUMBER FOR DCB
	MOV	(R2),R2		;GET LENGTH OF UCB
	CLR	R0		;SET UP R0,R1
	DIV	R2,R0		;CALC RELATIVE UNIT NUMBER FOR THIS DCB
	ADD	R0,(R3)+	;CALC LOGICAL UNIT NUMBER
	CLRB	-1(R3)		;CLEAR STUFF LEFT IN HIGH BYTE
	MOV	R4,(R3)		;PUT CPB ADDR IN BUFFER
	MOV	(SP)+,R1	;RESTORE BUFFER ADDRESS
	RETURN			;
;
; SNDCLI - SEND CLI PROMPTS TO CPRCLI
;
; INPUT:   $CPPKT - ADDRESS OF CPRBUF PACKET
;	   R0     - EXIT STATUS (PRESERVED IN R0)
;
	.IF DF C$$RMT		;REMOTE TASK SUPPORT
SNDCLI:
;
; FILL IN HEADER OF PACKET
;
	MOV	KISAR6,-(SP)		; SAVE CURRENT MAPPING
	MOV	$CPPKT,KISAR6		; MAP CPRBUF PACKET
	CLR	$CPPKT			; INDICATE PACKET USED
	MOV	#140000,R1		; POINT TO HEADER OF PACKET
	MOVB	#HT$SET,H$TYPE(R1) 	; SET TYPE OF SET_INFO
	MOVB	#2,H$ICNT(R1)		; TWO ITEMS
	ADD	#H$SIZE,R1		; POINT TO ITEM
;
; FILL IN DEFAULT PROMPT ITEM
;
	MOVB	#II$DPR,I$ID(R1) 	; SET ID
	CLR	R2			; ASSUME NO PROMPT
	BIT	#CP.NUL,C.PSTS(R4)	; CLI DOES IT'S OWN PROMPTING?
	BNE	2$			; IF NE YES
	MOVB	C.PDPL(R4),R2		; SET LENGTH OF DEFAULT PROMPT
	BEQ	2$
	ADD	#1,R2			; INCLUDE LENGTH BYTE
2$:	MOVB	R2,I$LEN(R1) 
	MOV	R1,I$BUF(R1)		; CALCULATE OFFSET TO PROMPT
	SUB	#140000-12,I$BUF(R1) 	; PROMPT COMES AFTER ITEMS
	ADD	#4,R1			; POINT TO NEXT ITEM
;
; FILL IN ^C PROMPT ITEM
;
	MOVB	#II$CPR,I$ID(R1) 	; SET ID
	CLR	R3			; ASSUME NO PROMPT
	BIT	#CP.NUL,C.PSTS(R4)	; CLI DOES IT'S OWN PROMPTING?
	BNE	3$			; IF NE YES
	MOVB	C.PCPL(R4),R3		; SET LENGTH OF CONTROL C PROMPT
	BEQ	3$	
	ADD	#1,R3			; INCLUDE LENGTH BYTE
3$:	MOVB	R3,I$LEN(R1)
	MOV	R1,I$BUF(R1)		; CALCULATE OFFSET TO PROMPT
	ADD	R2,I$BUF(R1) 		; SKIP OVER DEFAULT PROMPT
	SUB	#140000-6,I$BUF(R1) 	; SKIP ITEM
	ADD	#4,R1			; POINT TO STORAGE FOR STATUS
;
; SAVE EXIT STATUS
;
	MOV	R0,(R1)+		;
;
; DON'T COPY PROMPTS IF CLI DOES IT'S OWN PROMPTING
;
	BIT	#CP.NUL,C.PSTS(R4)	; CLI DOES IT'S OWN PROMPTING?
	BNE	25$			; IF NE YES
;
; COPY DEFAULT PROMPT
;
	MOVB	C.PDPL(R4),R2		; GET LENGTH OF DEFAULT PROMPT
	BEQ	15$
	MOV	R4,R3			; GET ADDRESS OF PROMPT
	ADD	#C.PRMT,R3 
	MOVB	R2,(R1)+		; PUT LENGTH INTO BUFFER
10$:	MOVB	(R3)+,(R1)+		; COPY A CHARACTER
	SOB	R2,10$			; UNTIL DONE
;
; COPY CONTROL C PROMPT
;
15$:
 	MOVB	C.PCPL(R4),R2		; GET LENGTH OF ^C PROMPT
	BEQ	25$
	MOVB	R2,(R1)+		; PUT LENGTH INTO BUFFER
20$:	MOVB	(R3)+,(R1)+		; COPY A CHARACTER
	SOB	R2,20$			; UNTIL DONE				
25$:	
	MOV	KISAR6,R0		; GET PACKET BIAS
	MOV	(SP)+,KISAR6		; RESTORE MAPPING
	SUB	#140000,R1		; GET SIZE OF REQUEST
	MOV	#SN$IMP,R5		; GET SEND FLAG
	BIC	#SF$DSW,R5		; THIS MAY NOT BE A DIRECTIVE
;
; SEND PACKET
;
	CPSEN$	R5,R0,R1		; SEND PACKET TO CPRCLI
;
; GET EXIT STATUS BACK
;
	MOV	KISAR6,-(SP)		; SAVE MAPPING
	MOV	R0,KISAR6		; MAP PACKET
	MOV	140000+H$SIZE+10,R5	; GET STATUS
	MOV	(SP)+,KISAR6		; RESTORE MAPPING
;
; DEALLOCATE PACKET
;
	CALL	$CPDEA			; DEALLOCATE PACKET
;
; RETURN WITH STATUS
;
	MOV	R5,R0			;
	RETURN				;

	.ENDC	;C$$RMT

	.ENDC	;A$$CLI

	.END